(**
 * Elaborated interface
 *
 * @copyright (C) 2021 SML# Development Team.
 * @author UENO Katsuhiro
 *
 * 2012-10-13 ohori:
   Changed string id and longids to symbols and long symbols
 *)
structure PatternCalcInterface =
struct

  (*% @formatter(Loc.loc) Loc.format_loc *)
  type loc = Loc.loc

  (*% @formatter(AbsynTy.ty) AbsynTyFormatter.format_ty *)
  type ty = AbsynTy.ty

  (*% @formatter(Symbol.symbol) Symbol.format_symbol*)
  type symbol = Symbol.symbol

  (*% @formatter(Symbol.longsymbol) Symbol.format_longsymbol*)
  type longsymbol = Symbol.longsymbol

  (*% @formatter(AbsynTy.tvar) AbsynTyFormatter.format_tvar *)
  type tvar = AbsynTy.tvar

  (*% @formatter(PatternCalc.scopedTvars) PatternCalc.format_scopedTvars *)
  type scopedTvars = PatternCalc.scopedTvars

  (*%
   * @formatter(AbsynInterface.overloadCase) AbsynInterface.format_overloadCase
   *)
  type overloadCase = AbsynInterface.overloadCase

(*
  (*%
   * @formatter(AbsynInterface.overloadMatch)
   * AbsynInterface.format_overloadMatch
   *)
  type overloadMatch = AbsynInterface.overloadMatch
*)

  (*%
   * @formatter(AbsynInterface.overloadInstance)
   * AbsynInterface.format_overloadInstance
   *)
  datatype overloadInstance = datatype AbsynInterface.overloadInstance

  (*%
   * @formatter(AbsynInterface.valbindBody) AbsynInterface.format_valbindBody
   *)
  datatype valbindBody = datatype AbsynInterface.valbindBody

  (*%
   * @formatter(AbsynInterface.datbind) AbsynInterface.format_datbind
   *)
  type datbind = AbsynInterface.datbind

  (*%
   * @formatter(option) TermFormat.formatOptionalOption
   * @formatter(declist) TermFormat.formatDeclList
   * @formatter(PatternCalc.plsigexp) PatternCalc.format_plsigexp
   * @formatter(RuntimeTypes.bty) RuntimeTypes.format_bty
   * @formatter(AbsynTy.opaque_impl) AbsynTyFormatter.format_opaque_impl
   * @formatter(seq) TermFormat.formatSeqList
   * @formatter(ifCons) TermFormat.formatIfCons
   * @formatter(bool) SmlppgUtil.formatBinaryChoice
   *)
  datatype pidec =
      (*%
         @format({scopedTvars, symbol, body, loc})
           "val" + scopedTvars body()(symbol)
       *)
      PIVAL of
      {
        scopedTvars: scopedTvars,
        symbol: symbol,
        body: valbindBody,
        loc: loc
      }
    | (*%
        @format({tyvars: tv tvs, symbol, ty, loc})
          "type" +d 
            tvs:seq(tv)("(",",",")")
            tvs:ifCons()(+)
            symbol +d "="
        2[ +1 ty ]
       *)
      (*
       * type 'a foo = ty            
       *)
      PITYPE of
      {
        tyvars: tvar list,
        symbol: symbol,
        ty: ty,
        loc: loc
      }
    | (*%
         @format({eq, tyvars: tv tvs, symbol, runtimeTy, loc})
          eq()("eqtype","type") +d 
           tvs:seq(tv)("(",",",")") 
           tvs:ifCons()(+)
           symbol +d "(=" +d runtimeTy +d ")"
       *)
      (*
       * type 'a foo ( = runtimeTy ) 
       *)
      PIOPAQUE_TYPE of
      {
        eq: bool,
        tyvars: tvar list,
        symbol: symbol,
        runtimeTy: AbsynTy.opaque_impl,
        loc: loc
      }
    | (*%
       * @format({symbol, builtinSymbol, loc})
       * "datatype" +d symbol +d "="
       * 2[ +1 "_builtin" +d "datatype" +d builtinSymbol ]
      *)
      (*
       *                syntax                               
       * datatype foo = _builtin datatype int                
       *)
      PITYPEBUILTIN of
      {
        symbol: symbol,
        builtinSymbol: symbol,
        loc: loc
      }
    | (*%
       * @format({datbind: bind binds, loc})
       * "datatype" +d binds(bind)(+1 "and" +d)
       *)
      PIDATATYPE of {datbind: datbind list, loc: loc}
    | (*%
       * @format({symbol, longsymbol, loc})
       * "datatype" +d symbol +d "="
       * 2[ +1 "datatype" +d longsymbol ]
       *)
      (*
       *                syntax
       * datatype foo = datatype bar
       *)
      PITYPEREP of {symbol: symbol, longsymbol: longsymbol, loc: loc}
    | (*%
         @format({symbol, ty: ty tyopt, loc})
         "exception" +d symbol 2[ tyopt(ty)("of" +1,) ]
       *)
      PIEXCEPTION of {symbol: symbol,
                      ty: ty option, 
                      loc: loc}
    | (*%
       * @format({symbol, longsymbol, loc})
       * "exception" +d symbol +d 2[ "=" longsymbol ]
       *)
      PIEXCEPTIONREP of {symbol: symbol, longsymbol: longsymbol, loc: loc}
    | (*%
       * @format({symbol, strexp, loc})
       * "structure" +d symbol +d "=" 2[ +1 strexp ]
       *)
      PISTRUCTURE of {symbol: symbol, strexp: pistrexp, loc: loc}

  and pistrexp =
      (*%
       * @format({decs: dec decs, loc})
           "struct"
           1[
             decs:declist(dec)(+1,+1)
            ]
            1
          "end"
       *)
      PISTRUCT of {decs: pidec list, loc: loc}
    | (*%
         @format({longsymbol, loc}) longsymbol
       *)
      PISTRUCTREP of {longsymbol:longsymbol, loc: loc}
    | (*%
         @format({functorSymbol, argument, loc}) functorSymbol "(" argument ")"
       *)
      PIFUNCTORAPP of {functorSymbol:symbol, argument:longsymbol, loc:loc}

  (*%
   * @formatter(PatternCalc.plsigexp) PatternCalc.format_plsigexp
   *)
  type funbind =
      (*%
       * @format({functorSymbol, param, strexp, loc})
       * functorSymbol "(" param ")" +d "=" 2[ +1 strexp ]
       * @format:param({strSymbol, sigexp})
          strSymbol +1 ":" +d sigexp
       *)
      {functorSymbol: symbol,
       param: {strSymbol: symbol, sigexp: PatternCalc.plsigexp},
       strexp: pistrexp,
       loc:loc}

  (*% *)
  datatype pitopdec =
      (*% @format(x) x *)
      PIDEC of pidec
    | (*%
       * @format(funbind)
       * "functor" +d funbind
       *)
      PIFUNDEC of funbind

  (*% @formatter(InterfaceID.id) InterfaceID.format_id *)
  type interfaceId =
       (*% @format(id) "i" id *)
       InterfaceID.id

  (*%
   * @formatter(decList) TermFormat.formatDeclList
   *)
  type interfaceDec =
      (*%
       * @format({interfaceId, interfaceName, requiredIds: req reqs, provideTopdecs: dec decs})
       * "interface" +d interfaceId
       * 2[ reqs:decList(req)(+1, +1) ]
       * +1 "in"
       * 2[ decs:decList(dec)(+1, +1) ]
       * +1 "end"
       * @format:req({id, loc})
       * "require:" +d id
       *)
      {
        interfaceId: interfaceId,
        interfaceName: InterfaceName.interface_name,
        requiredIds: {id: interfaceId, loc: loc} list,
        provideTopdecs: pitopdec list
      }

  (*%
   * @formatter(decList) TermFormat.formatDeclList
   *)
  type interface =
      (*%
       * @format({interfaceDecs: bind binds,
       *          requiredIds: req reqs,
       *          locallyRequiredIds: lreq lreqs,
       *          provideTopdecs: pdec pdecs})
       * "local"
       * 2[ binds:decList(bind)(+1, +1) ]
       * +1 "provide"
       * 2[ pdecs:decList(pdec)(+1, +1) ]
       * +1 "in"
       * 2[ reqs:decList(req)(+1, +1) ]
       * 2[ lreqs:decList(lreq)(+1, +1) ]
       * @format:req({id, loc})
       * "require" +d id
       * @format:lreq({id, loc})
       * "local require:" +d id
       *)
      {
        interfaceDecs : interfaceDec list,
        requiredIds : {id: interfaceId, loc: loc} list,
        locallyRequiredIds: {id: interfaceId, loc: loc} list,
        provideTopdecs : pitopdec list
      }

  (*%
   * @formatter(PatternCalc.pltopdec) PatternCalc.format_pltopdec
   * @formatter(option) TermFormat.formatOptionalOption
   * @formatter(decList) TermFormat.formatDeclList
   *)
  type compile_unit =
      (*%
       * @format({interface:interface interfaceOpt, topdecsSource: dec decs, topdecsInclude:inc incs})
       * interfaceOpt(interface)(,)
       * 2[ incs:decList(inc)(+1, +1) ]
       * 2[ decs:decList(dec)(+1, +1) ]
       * +1 "end"
       *)
      {
        interface : interface option,
        topdecsSource : PatternCalc.pltopdec list,
        topdecsInclude : PatternCalc.pltopdec list
      }

  (* an interface loaded as if it is "_require"-ed *)
  (*%
   * @formatter(decList) TermFormat.formatDeclList
   * @formatter(PatternCalc.pltopdec) PatternCalc.format_pltopdec
   *)
  type interface_unit =
      (*%
       * @format({interfaceDecs: bind binds,
       *          requiredIds: req reqs,
       *          topdecsInclude: inc incs})
       * "interfaces"
       * 2[ binds:decList(bind)(+1, +1) ]
       * +1 "requires"
       * 2[ reqs:decList(req)(+1, +1) ]
       * +1 "topdesInclude"
       * 2[ incs:decList(inc)(+1, +1) ]
       * @format:req({id, loc})
       * "require" +d id
       *)
      {
        interfaceDecs : interfaceDec list,
        requiredIds : {id: interfaceId, loc: loc} list,
        topdecsInclude : PatternCalc.pltopdec list
      }

  (*%
   * @formatter(PatternCalc.plstrdec) PatternCalc.format_plstrdec
   * @formatter(PatternCalc.plsigexp) PatternCalc.format_plsigexp
   * @formatter(PatternCalc.plstrexp) PatternCalc.format_plstrexp
   * @formatter(option) TermFormat.formatOptionalOption
   * @formatter(funbind) format_funbind
   * @formatter(declist) TermFormat.formatDeclList
   *)
  datatype topdec
    = (*%
       * @format(plstrdec * loc) 
       *   "TOPDECSTR(" plstrdec ")"
      *)
      TOPDECSTR of PatternCalc.plstrdec * loc
    | (*%
       * @format(sigbind sigbinds * loc) "TOPDECSIG"
      *)
      TOPDECSIG of (symbol * PatternCalc.plsigexp ) list * loc 
    | (*%
       * @format(decfun decfuns * loc)
       *  "TOPDECFUN:" \n
       *  decfuns:declist(decfun:decfun)(+1 ",", +d)
       *
       * @format:decfun({pltopdec:pltop, pitopdec:funbind funbindOpt})
       *  "pltopdec" \n
       *   pltop:pltop \n
       *  "pitopdec" \n
       *   funbindOpt(funbind)(,) \n
       *
       * @format:pltop({name, argStrName, argSig, body, loc})
       *  "functor" + name + "(" argStrName ":" argSig ") =" +d
       *  body
      *)
       TOPDECFUN of
         {pltopdec: {name:symbol, 
                     argStrName:symbol, 
                     argSig:PatternCalc.plsigexp, 
                     body:PatternCalc.plstrexp, 
                     loc:loc},
          pitopdec: funbind option} list * loc 

  (*%
   * @formatter(option) TermFormat.formatOptionalOption
   * @formatter(declist) TermFormat.formatDeclList
   *)
  type compile_unit_spliced
    = (*%
       * @format({interface:interface interfaceOpt,
       *          topdecsInclude:inctopdec inctopdecs,
       *          topdecsSource:srctopdec srctopdecs})
       * "interface" \n
       * interfaceOpt(interface)(,)
       * \n
       * "topdecsInclude" \n
         inctopdecs:declist(inctopdec)(+1, +1)
       * "topdecsSource" \n
         srctopdecs:declist(srctopdec)(+1, +1)
      *)
      {
        interface : interface option,
        topdecsInclude : topdec list,
        topdecsSource : topdec list
      }

  fun pitopdecLoc pitopdec =
      case pitopdec of
        PIDEC pidec => pidecLoc pidec
      | PIFUNDEC {loc,...} => loc
  and pidecLoc pidec =
      case pidec of
        PIVAL {loc,...} => loc
      | PITYPE {loc,...} => loc
      | PIOPAQUE_TYPE {loc,...} => loc
      | PITYPEBUILTIN {loc,...} => loc
      | PIDATATYPE {loc,...} => loc
      | PITYPEREP {loc,...} => loc
      | PIEXCEPTION {loc,...} => loc
      | PIEXCEPTIONREP {loc,...} => loc
      | PISTRUCTURE {loc,...} => loc

end
